home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / shazam11.zip / GENERAL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-11-04  |  9KB  |  261 lines
  1. {$X+}
  2. UNIT General;INTERFACE USES Dos,Crt,                             { TP }
  3.                             App,Dialogs,Views,Objects,StdDlg,    { TV }
  4.                             Drivers,Memory,MsgBox,               { TV }
  5.                             Buffers;                             { TV }
  6.    {===================================================================
  7.  
  8.    Turbo Vision, General Purpose code.
  9.    Used with, but not part of, TurboVision objects.
  10.  
  11.    ===================================================================}
  12. procedure heDosShell ;                                         { EXEC }
  13. procedure heCloseAll ;                                      { Desktop }
  14. procedure heZoomAll ;                                       { Desktop }
  15. procedure heTile ;                                          { Desktop }
  16. procedure heCascade ;                                       { Desktop }
  17. procedure heChangeDir ;                                     { Desktop }
  18. function  ExecDialog         ( P : PDialog ;
  19.                                Data : pointer ) : word ;    { General }
  20. procedure heRefreshDisplay ;                                { Display }
  21. procedure heColor ;                                         { Palette }
  22. procedure heBlackWhite ;                                    { Palette }
  23. procedure heMonochrome ;                                    { Palette }
  24. procedure PushScreen ;                                      { General }
  25. procedure PullScreen ;                                      { General }
  26. procedure PopScreen ;                                       { General }
  27.  
  28. IMPLEMENTATION
  29.    {===================================================================
  30.  
  31.    SHELL to DOS
  32.  
  33.    ===================================================================}
  34. procedure heDosShell ;
  35. var
  36.    UsingBuffers              : boolean ;
  37. begin
  38.    UsingBuffers              := BufHeapEnd > 0 ;
  39.    DoneSysError ;
  40.    DoneEvents ;
  41.    DoneVideo ;
  42.    DoneMemory ;
  43.    PopScreen ;
  44.    if UsingBuffers then
  45.       SetMemTop ( Ptr ( BufHeapPtr , 0 ) )
  46.    else
  47.       SetMemTop ( HeapPtr ) ;  
  48.    PrintStr ( 'Type ''EXIT'' to return...' ) ;
  49.    SwapVectors ;
  50.    Exec ( GetEnv ( 'COMSPEC' ) , '' ) ;
  51.    SwapVectors ;
  52.    if UsingBuffers then
  53.       SetMemTop ( Ptr ( BufHeapEnd , 0 ) )
  54.    else
  55.       SetMemTop ( HeapEnd ) ;
  56.    PushScreen ;
  57.    InitMemory ;
  58.    InitVideo ;
  59.    InitEvents ;
  60.    InitSysError ;
  61.    Application^.Redraw ;
  62.    if DosError <> 0 then
  63.       MessageBox ( 'Unable to SHELL to DOS' ,
  64.                    NIL ,
  65.                    mfError + mfOKbutton ) ;
  66. end ;
  67.    {===================================================================
  68.  
  69.    Executes a dialog box.
  70.    Returns
  71.    1.  cmXXXX variable, usually cmCancel or cmOK
  72.    2.  Data, a pointer to a data structure
  73.  
  74.    ===================================================================}
  75. function ExecDialog ( P : PDialog ; Data : pointer ) : word ;
  76. var
  77.    Result                    : word ;
  78. begin
  79.    Result                    := cmCancel ;
  80.    P                         := PDialog ( Application^.ValidView ( P ) ) ;
  81.    if P <> NIL then
  82.    begin
  83.       if Data <> NIL then
  84.          P^.SetData ( Data^ ) ;
  85.       Result                 := DeskTop^.ExecView ( P ) ;
  86.       if ( Result <> cmCancel ) and
  87.          ( Data <> NIL ) then
  88.          P^.GetData ( Data^ ) ;
  89.       Dispose ( P , Done ) ;
  90.    end ;
  91.    ExecDialog                := Result ;
  92. end ;
  93.    {-------------------------------------------------------------------
  94.    CLOSE ALL
  95.    -------------------------------------------------------------------}
  96. procedure heCloseAll ;
  97.  
  98. procedure DoThis ( P : PView ) ; FAR ;
  99. begin
  100.    Message ( P , evCommand , cmClose , NIL ) ;
  101. end ;
  102.  
  103. begin
  104.    Desktop^.ForEach ( @DoThis ) ;
  105. end ;
  106.    {-------------------------------------------------------------------
  107.    ZOOM ALL
  108.    -------------------------------------------------------------------}
  109. procedure heZoomAll ;
  110.  
  111. procedure DoThis ( P : PView ) ; FAR ;
  112. begin
  113.    Message ( P , evCommand , cmZoom , NIL ) ;
  114. end ;
  115.  
  116. begin
  117.    Desktop^.ForEach ( @DoThis ) ;
  118. end ;
  119.    {-------------------------------------------------------------------
  120.    "TILE" DeskTop windows
  121.    -------------------------------------------------------------------}
  122. procedure heTile ;
  123. var
  124.    R                         : TRect ;
  125. begin
  126.    Desktop^.GetExtent ( R ) ;
  127.    Desktop^.Tile ( R ) ;
  128. end ;
  129.    {-------------------------------------------------------------------
  130.    "CASCADE" DeskTop windows
  131.    -------------------------------------------------------------------}
  132. procedure heCascade ;
  133. var
  134.    R                         : TRect ;
  135. begin
  136.    Desktop^.GetExtent ( R ) ;
  137.    Desktop^.Cascade ( R ) ;
  138. end ;
  139.    {-------------------------------------------------------------------
  140.    CHANGE SUB-DIRECTORY   
  141.    -------------------------------------------------------------------}
  142. procedure heChangeDir ;
  143. begin
  144.    ExecDialog ( New ( PChDirDialog ,
  145.                       Init ( cdNormal , 0 ) ) , NIL ) ;
  146. end ;
  147.    {===================================================================
  148.  
  149.    DISPLAY:  Redraw the screen
  150.  
  151.    ===================================================================}
  152. procedure heRefreshDisplay ;
  153. begin
  154.    DoneMemory ;                                  { Dump cache buffers }
  155.    Application^.Redraw ;                              { Redisplay all }
  156. end ;
  157.    {===================================================================
  158.  
  159.    PALETTE
  160.  
  161.    ===================================================================}
  162.    {-------------------------------------------------------------------
  163.    COLOR
  164.    -------------------------------------------------------------------}
  165. procedure heColor ;
  166. begin
  167.    AppPalette                := apColor ;
  168.    DoneMemory ;
  169.    Application^.Redraw ;
  170. end ;
  171.    {-------------------------------------------------------------------
  172.    BW
  173.    -------------------------------------------------------------------}
  174. procedure heBlackWhite ;
  175. begin
  176.    AppPalette                := apBlackWhite ;
  177.    DoneMemory ;
  178.    Application^.Redraw ;
  179. end ;
  180.    {-------------------------------------------------------------------
  181.    MONO
  182.    -------------------------------------------------------------------}
  183. procedure heMonochrome ;
  184. begin
  185.    AppPalette                := apMonochrome ;
  186.    DoneMemory ;
  187.    Application^.Redraw ;
  188. end ;
  189.    {===================================================================
  190.  
  191.    MONITOR TYPE
  192.  
  193.    ===================================================================}
  194. function IsMono : boolean ;
  195. var
  196.    CrtMode                   : byte Absolute $0040:$0049 ;
  197. begin
  198.    IsMono                    := CrtMode = 7 ;
  199. end ;
  200.    {===================================================================
  201.  
  202.    VIDEO LOCATION
  203.  
  204.    ===================================================================}
  205. function VideoMemory : LongInt ;
  206. const
  207.    MonoScreen                : word = $B000 ;
  208.    ColorScreen               : word = $B800 ;
  209. begin
  210.    if IsMono then
  211.       VideoMemory            := MonoScreen
  212.    else
  213.       VideoMemory            := ColorScreen ;
  214. end ;
  215.    {===================================================================
  216.  
  217.    SCREEN PUSH/POP
  218.  
  219.    ===================================================================}
  220.    {-------------------------------------------------------------------
  221.    DATA
  222.    -------------------------------------------------------------------}
  223. const
  224.    SaveScreen                : pointer = NIL ;
  225. var
  226.    OldX ,
  227.    OldY                      : byte ;
  228.    {-------------------------------------------------------------------
  229.    SAVE
  230.    -------------------------------------------------------------------}
  231. procedure PushScreen ;
  232. begin
  233.    if SaveScreen <> NIL then EXIT ;
  234.    OldX                      := WhereX ;
  235.    OldY                      := WhereY ;
  236.    GetMem ( SaveScreen , 4000 ) ;
  237.    Move ( Mem [ VideoMemory : 0 ] , SaveScreen^ , 4000 ) ;
  238. end ;
  239.    {-------------------------------------------------------------------
  240.    SHOW
  241.    -------------------------------------------------------------------}
  242. procedure PullScreen ;
  243. begin
  244.    if SaveScreen = NIL then EXIT ;
  245.    Move ( SaveScreen^, Mem [ VideoMemory : 0 ] , 4000 ) ;
  246.    GotoXY ( OldX , OldY ) ;
  247. end ;
  248.    {-------------------------------------------------------------------
  249.    RESTORE
  250.    -------------------------------------------------------------------}
  251. procedure PopScreen ;
  252. begin
  253.    if SaveScreen = NIL then EXIT ;
  254.    PullScreen ;
  255.    FreeMem ( SaveScreen , 4000 ) ;
  256.    SaveScreen                := NIL ;
  257. end ;
  258.    {^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  259.    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}
  260. END.
  261.